home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / src-elk / object.h < prev    next >
Encoding:
C/C++ Source or Header  |  1992-11-13  |  7.0 KB  |  277 lines
  1. #ifndef OBJECT_H
  2. #define OBJECT_H
  3.  
  4. #define VALBITS         24
  5. #define VALMASK         ((1 << VALBITS) - 1)
  6. #define SIGNBIT         (1 << (VALBITS-1))
  7. #define SIGNMASK        ~(SIGNBIT-1)
  8. #define FIXNUM_FITS(x)  (((x) & SIGNMASK) == 0 || ((x) & SIGNMASK) == SIGNMASK)
  9. #define FIXNUM_FITS_UNSIGNED(x)     (((x) & SIGNMASK) == 0)
  10.  
  11. #define CONSTBIT        (1 << VALBITS)
  12.  
  13. #define TYPESHIFT       (VALBITS+1)
  14.  
  15. typedef unsigned Object;
  16.  
  17. #define MAX_TYPE        (1 << (sizeof(Object)*8 - TYPESHIFT))
  18.  
  19. /* Extract/Set/Compare the type and val components of Objects:
  20.  */
  21.  
  22. #define TYPE(x) ((int)((x) >> TYPESHIFT))
  23. #define SETTYPE(x,t) ((x) = ((x) & VALMASK) | ((x) & CONSTBIT) | \
  24.                 ((int)(t) << TYPESHIFT))
  25.  
  26. #define FIXNUM(x) (((int)(x) << (32-VALBITS)) >> (32-VALBITS))
  27.  
  28. #define SETFIXNUM(x,i) ((x) = ((x) & ~VALMASK) | ((i) & VALMASK))
  29.  
  30. #define CHAR(x) ((int)((x) & VALMASK))
  31.  
  32. #ifndef POINTER_CONSTANT_HIGH_BITS
  33. #  define POINTER(x) ((x) & VALMASK)
  34. #else
  35. #  define POINTER(x) (((x) & VALMASK) | POINTER_CONSTANT_HIGH_BITS)
  36. #endif
  37. #define SETPOINTER(x,p) SETFIXNUM(x,(int)(p))
  38.  
  39. #define ISCONST(x) ((x) & CONSTBIT)
  40. #define SETCONST(x) ((x) |= CONSTBIT)
  41.  
  42. #define SET(x,t,p) ((x) = ((int)(t) << TYPESHIFT) | ((int)(p) & VALMASK))
  43.  
  44. #define EQ(x,y) ((x) == (y))
  45.  
  46. #define SETFAST(x,y) ((x) = (y))
  47.  
  48. /* GC related macros:
  49.  */
  50. #ifdef GENERATIONAL_GC
  51.    /* not yet there */
  52. #else
  53. #  define WAS_FORWARDED(obj) (TYPE(*(Object *)POINTER(obj)) == T_Broken_Heart)
  54. #  define IS_ALIVE(obj)      WAS_FORWARDED(obj)
  55. #  define UPDATE_OBJ(obj)    SETPOINTER(obj, POINTER(*(Object *)POINTER(obj)))
  56. #  define REVIVE_OBJ(obj)
  57. #endif
  58.  
  59. /* Fixed types.  Cannot use enum, because the set of types is extensible:
  60.  */
  61. #define T_Fixnum          0      /* Must be 0 */
  62. #define T_Bignum          1
  63. #define T_Flonum          2
  64. #define T_Null            3      /* empty list */
  65. #define T_Boolean         4      /* #t (1) and #f (0) */
  66. #define T_Void            5      /* doesn't print */
  67. #define T_Unbound         6      /* only used internally */
  68. #define T_Special         7      /* only used internally */
  69. #define T_Character       8
  70. #define T_Symbol          9
  71. #define T_Pair           10
  72. #define T_Environment    11      /* A pair */
  73. #define T_String         12
  74. #define T_Vector         13
  75. #define T_Primitive      14      /* Primitive procedure */
  76. #define T_Compound       15      /* Compound procedure */
  77. #define T_Control_Point  16
  78. #define T_Promise        17      /* Result of (delay expression) */
  79. #define T_Port           18
  80. #define T_End_Of_File    19
  81. #define T_Autoload       20
  82. #define T_Macro          21
  83. #define T_Broken_Heart   22      /* only used internally */
  84.  
  85. #define T_Last T_Broken_Heart
  86.  
  87. #define BIGNUM(x)   ((struct S_Bignum *)POINTER(x))
  88. #define FLONUM(x)   ((struct S_Flonum *)POINTER(x))
  89. #define STRING(x)   ((struct S_String *)POINTER(x))
  90. #define VECTOR(x)   ((struct S_Vector *)POINTER(x))
  91. #define SYMBOL(x)   ((struct S_Symbol *)POINTER(x))
  92. #define PAIR(x)     ((struct S_Pair *)POINTER(x))
  93. #define PRIM(x)     ((struct S_Primitive *)POINTER(x))
  94. #define COMPOUND(x) ((struct S_Compound *)POINTER(x))
  95. #define CONTROL(x)  ((struct S_Control *)POINTER(x))
  96. #define PROMISE(x)  ((struct S_Promise *)POINTER(x))
  97. #define PORT(x)     ((struct S_Port *)POINTER(x))
  98. #define AUTOLOAD(x) ((struct S_Autoload *)POINTER(x))
  99. #define MACRO(x)    ((struct S_Macro *)POINTER(x))
  100.  
  101. typedef unsigned short gran_t;    /* Granularity of bignums */
  102.  
  103. struct S_Bignum {
  104.     Object minusp;
  105.     unsigned size;        /* Number of ushorts allocated */
  106.     unsigned usize;        /* Number of ushorts actually used */
  107.     gran_t data[1];        /* Data, lsw first */
  108. };
  109.  
  110. struct S_Flonum {
  111.     Object tag;               /* Each S_Foo must start with an Object */
  112.     double val;
  113. };
  114.  
  115. struct S_Symbol {
  116.     Object next;
  117.     Object name;               /* A string */
  118.     Object value;
  119.     Object plist;
  120. };
  121.  
  122. struct S_Pair {
  123.     Object car, cdr;
  124. };
  125.  
  126. struct S_String {
  127.     Object tag;
  128.     int size;
  129.     char data[1];
  130. };
  131.  
  132. struct S_Vector {
  133.     Object tag;
  134.     int size;
  135.     Object data[1];
  136. };
  137.  
  138. #if ZELK
  139.  enum discipline { EVAL, NOEVAL, VARARGS, FOREIGN };
  140. #else
  141.  enum discipline { EVAL, NOEVAL, VARARGS };
  142. #endif
  143. struct S_Primitive {
  144.     Object tag;
  145.     Object (*fun) P_((ELLIPSIS));
  146.     char *name;
  147.     int minargs;
  148.     int maxargs;    /* Or MANY */
  149.     enum discipline disc;
  150. #if ZELK
  151.     unsigned char *forfunargs;  /* foreign function arguments */
  152. #endif
  153. };
  154. #define MANY    100
  155.  
  156. struct S_Compound {
  157.     Object closure;     /* (lambda (args) form ...) */
  158.     Object env;         /* Procedure's environment */
  159.     int min_args, max_args;
  160.     Object name;
  161. };
  162.  
  163. typedef struct wind {
  164.     struct wind *next, *prev;
  165.     Object inout;                  /* Pair of thunks */
  166. } WIND;
  167.  
  168. typedef struct funct {
  169.     struct funct *next;
  170.     void (*func) P_((void));
  171. } FUNCT;
  172.  
  173. typedef struct gcnode {
  174.     struct gcnode *next;
  175.     int gclen;
  176.     Object *gcobj;
  177. } GCNODE;
  178.  
  179. typedef struct mem_node {
  180.     struct mem_node *next;
  181.     unsigned len;
  182.     unsigned long refcnt;
  183. } MEM_NODE;
  184.  
  185. struct S_Control {
  186.     Object env;
  187.     GCNODE *gclist;
  188.     MEM_NODE *memlist;
  189.     Object memsave;             /* string */
  190.     Object gcsave;              /* vector */
  191.     WIND *firstwind, *lastwind;
  192.     int tailcall;
  193.     unsigned delta;
  194.     jmp_buf j;
  195.     int size;
  196.     char stack[1];
  197. };
  198.  
  199. struct S_Promise {
  200.     Object env;
  201.     Object thunk;
  202.     int done;
  203. };
  204.  
  205. struct S_Port {
  206.     Object name;    /* string */
  207.     short flags;
  208.     char unread;
  209.     int ptr;
  210.     FILE *file;
  211.     unsigned lno;
  212. };
  213. #define P_OPEN    1 /* flags */
  214. #define P_INPUT   2
  215. #define P_STRING  4
  216. #define P_UNREAD  8
  217. #define P_BIDIR  16
  218.  
  219. #define IS_INPUT(port)   (PORT(port)->flags & (P_INPUT|P_BIDIR))
  220. #define IS_OUTPUT(port) ((PORT(port)->flags & (P_INPUT|P_BIDIR)) != P_INPUT)
  221.  
  222. struct S_Autoload {
  223.     Object files;
  224.     Object env;
  225. };
  226.  
  227. struct S_Macro {
  228.     Object body;
  229.     int min_args, max_args;
  230.     Object name;
  231. };
  232.  
  233.  
  234. /* "size" is called with one object and returns the size of the object.
  235.  *    If "size" is NOFUNC, then "const_size" is taken instead.
  236.  * "eqv" and "equal" are called with two objects and return 0 or 1.
  237.  *    NOFUN may be passed instead (than eqv and equal always return #f).
  238.  * "print" is called with an object, a port, a flag indicating whether
  239.  *    the object is to be printed "raw" (a la display), the print-depth,
  240.  *    and the print-length.
  241.  * "visit" is called with a pointer to an object and a function.
  242.  *    For each component of the object, the function must be called with
  243.  *    a pointer to the component.  NOFUNC may be supplied.
  244.  */
  245. typedef struct {
  246.     int haspointer;
  247.     char *name;
  248.     int (*size) P_((Object));
  249.     int const_size;
  250.     int (*eqv) P_((Object, Object));
  251.     int (*equal) P_((Object, Object));
  252.     int (*print) P_((Object, Object, int, int, int));
  253.     int (*visit) P_((Object*, int (*)(Object*)));
  254. } TYPEDESCR;
  255. #define NOFUNC ((int (*)P_((ELLIPSIS)))0)
  256.  
  257.  
  258. typedef struct sym {
  259.     struct sym *next;
  260.     char *name;
  261.     unsigned long value;
  262. } SYM;
  263.  
  264. typedef struct {
  265.     SYM *first;
  266.     char *strings;
  267. } SYMTAB;
  268.  
  269.  
  270. typedef struct weak_node {
  271.     struct weak_node *next;
  272.     Object object;
  273.     void (*terminate) P_((Object));
  274. } WEAK_NODE;
  275.  
  276. #endif
  277.